perm filename CYCDRJ.LSP[3,LMM] blob sn#038916 filedate 1973-05-01 generic text, type T, neo UTF8

(DEFPROP CYCDRJFNS
 (CYCDRJFNS ISOMERS RING DRAW LABELLER DRAWS)
VALUE)

(DEFPROP ISOMERS
 (LAMBDA NIL
  (PROG	(CL U)
   CLLP	(PRINT (QUOTE CL?))
	(SETQ CL (READ))
	(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
	(COND
	 ((FOR NEW
	       PR
	       IN
	       CL
	       OR
	       (OR (ATOM PR)
		   (NOT (NUMBERP (CDR PR)))
		   (NOT (ATOM (CAR PR)))
		   (NOT
		    (OR	(NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
			(PROG2 (TERPRI)
			       (PRINC (QUOTE "WHAT'S THE VALENCE OF "))
			       (PRINC (CAR PR))
			       (PRINC (QUOTE ?))
			       (NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
	  (GO CLLP)))
   ULP	(PRINT (QUOTE U?))
	(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
	(SETQ RESULTS (MOLECULES CL U))
	(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)

(DEFPROP RING
 (LAMBDA NIL
  (PROG	(CL U)
   CLLP	(PRINT (QUOTE CL?))
	(SETQ CL (READ))
	(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
	(COND
	 ((FOR NEW
	       PR
	       IN
	       CL
	       OR
	       (OR (ATOM PR)
		   (NOT (NUMBERP (CDR PR)))
		   (NOT (ATOM (CAR PR)))
		   (NOT
		    (OR	(NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
			(PROG2 (TERPRI)
			       (PRINC (QUOTE "WHAT'S THE VALENCE OF "))
			       (PRINC (CAR PR))
			       (PRINC (QUOTE ?))
			       (NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
	  (GO CLLP)))
   ULP	(PRINT (QUOTE U?))
	(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
	(SETQ RESULTS (RINGS U CL))
	(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)

(DEFPROP DRAW
 (LAMBDA(N)
  (PROG	(S)
	(COND ((GREATERP N (LENGTH RESULTS)) (PRINT (QUOTE (NOT THAT MANY STRUCTURES -- TRY AGAIN!!!))))
	      ((STRUCTURE? (SETQ S (CAR (NTH RESULTS N)))) (DRAWS S NIL))
	      (T (SETQ TITLE (LIST (QUOTE STRUCTURE#) N)) (PRINRAD S)))))
EXPR)

(DEFPROP LABELLER
 (LAMBDA NIL
  (PROG	(CL U)
   CLLP	(TERPRI)
	(PRINC (QUOTE "ATOMS TO BE LABELLED?"))
	(SETQ CL (READ))
	(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
	(COND
	 ((FOR NEW
	       PR
	       IN
	       CL
	       OR
	       (OR (ATOM PR)
		   (NOT (NUMBERP (CDR PR)))
		   (NOT (ATOM (CAR PR)))
		   (NOT
		    (OR	(NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
			(PROG2 (TERPRI)
			       (PRINC (QUOTE "WHAT'S THE VALENCE OF "))
			       (PRINC (CAR PR))
			       (PRINC (QUOTE ?))
			       (NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
	  (GO CLLP)))
   ULP	(PRINT (QUOTE U?))
	(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
	(SETQ RESULTS (MOLECULES CL U))
	(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)

(DEFPROP DRAWS
 (LAMBDA(STRUC ID)
  (LAYOUT
   (CONS (OR# ID (UGRAPH STRUC))
	 (FOR NEW
	      X
	      IN
	      (CTABLE STRUC)
	      XLIST
	      (CONS (NODENUM X)
		    (CONS (ATOMTYPE (MARKERS X)) (FOR NEW Y IN (NBRS X) WHEN (NUMBERP Y) XLIST Y)))))))
EXPR)